unit cuDebug;

interface

{
LOG_SEVERE, severe errors that require program exit (e.g., in an application, you ran out of disk space).
LOG_ERROR, error messages that can't be recovered from but the program can continue to run (e.g., in a server application, client sent through bad data but other clients can continue to run).
LOG_WARNING, recoverable problem that you should be notified about (e.g., invalid value in a configuration file, so you fell back to the default).
LOG_INFO, informational messages.
LOG_ENTRY, log entry and exit to all functions.
LOG_PARM, log entry and exit to all functions with parameters passed and values returned (including global effects if any).
LOG_DEBUG, general debugging messages, basically useful information that can be output on a single line.
LOG_HIDEBUG, far more detailed debugging messages such as hex dumps of buffers.
}

uses Classes, StdCtrls, ComCtrls, Graphics;

{
  LOG_SILENT    - Nothing gets debugged, not even forced.
  LOG_DEBUG1    - Only important debug messages, like major function calls.
  LOG_DEBUG2    - Inner function messages.
  LOG_DEBUG3    - Low level messages, like output from arrays etc.
  LOG_WARNING   - Errors which may cause problems down the line.
  LOG_CRITICAL  - Errors which may cause failures, such as out or range indexs in arrays.
  LOG_FORCE     - Will force a message to the console, and never goes to the buffer.
  LOG_BUFFER    - Messages are to be stored in a buffer until the buffer is cleared, or dumped to the console.
  LOG_DUMP      - Saves the log to a file, every time.
}

type
  TErrorState = ( LOG_SILENT, LOG_DEBUG1, LOG_DEBUG2, LOG_DEBUG3, LOG_WARNING, LOG_CRITICAL, LOG_FORCE, LOG_BUFFER, LOG_DUMP, LOG_DUMPNOW );

  TErrorStates = set of TErrorState;

  TDebugConsole = class( TObject )
  private
    m_Messages       : TStringList;
    m_Buffer         : TStringList; // Stores data until its flushed to the main line.
    m_LogLevel       : TErrorStates;
    m_LogFile        : string;
    m_Path           : string;
    m_CriticalError  : boolean;
    m_WarningError   : boolean;
    m_LogModified    : boolean;
    m_BufferModified : boolean;
  public
    runOnCritical    : procedure;
    runOnWarning     : procedure;
    DebugColor       : TColor;

    constructor Create(nMsg:string);
    destructor Destroy; override;
    procedure Clear;
    procedure resetError();
    procedure Print(ErrorState:TErrorState;text:String);
    procedure addStrings(nStrings:TStringList);
    procedure setLogFile(const Path,FileName:string);
    procedure saveLog();

    procedure clearBuffer();
    procedure flushBuffer();

    function showLogLevel():string;
    procedure modeBuffer(isEnabled:boolean);
    procedure modeSaveLog(isEnabled:boolean);

    procedure setLogLevel(newLevel:string);
    procedure setDebugLevel(newLevel:integer);
    procedure setDumpLevel(newLevel:integer);
    procedure exportMessages(var nRichEdit:TRichEdit);
    procedure setColor(const nColor:TColor);

    property Messages : TStringList read m_Messages write m_Messages;
    property LogFile : string read m_LogFile;
    property Path    : string read m_Path;
    property hasCritical: boolean read m_CriticalError;
    property hasWarning: boolean read m_WarningError;
  end;

var
  DevConsole : TDebugConsole;

implementation

uses SysUtils, cuFuncs, Dialogs, cuSplitLine;

constructor TDebugConsole.Create(nMsg:string); // I could set the debug level to log to buffer, until defaults can be set.
begin
  inherited Create;

  m_LogLevel      := [LOG_WARNING] + [LOG_CRITICAL] + [LOG_BUFFER]; // Have to manually turn on Debugs,

  m_Messages      := TStringList.Create;
  m_Buffer        := TStringList.Create;

  m_LogModified   := FALSE;

  runOnCritical   := nil;
  runOnWarning    := nil;

  DebugColor      := clSilver;

  m_LogFile := 'debug.log';
  m_Path    := GetEXEPath();

  if (nMsg <> '') then
    Print(LOG_FORCE, nMsg);
end;
destructor TDebugConsole.Destroy();
begin
  FreeAndNil( m_Messages );
  FreeAndNil( m_Buffer );

  inherited Destroy;
end;
procedure TDebugConsole.Clear();
begin
  m_Messages.Clear;
  m_Buffer.Clear;

  m_LogModified    := FALSE;
  m_BufferModified := FALSE;
  m_CriticalError  := FALSE;
  m_WarningError   := FALSE;
end;
procedure TDebugConsole.resetError();
begin
  m_CriticalError := FALSE;
  m_WarningError  := FALSE;
end;

procedure TDebugConsole.Print(ErrorState:TErrorState;Text:string);
var ErrorPrefix : string;
begin
  if not(ErrorState in m_LogLevel)and(ErrorState <> LOG_FORCE) then exit;

  if (LOG_SILENT in m_LogLevel) then exit; //Nothing is outputted

  if (Length(Text) <= 0) then exit; // Not going to save blank lines.

  case (ErrorState) of
    LOG_DEBUG1   : ErrorPrefix := '  1:';
    LOG_DEBUG2   : ErrorPrefix := '  2:';
    LOG_DEBUG3   : ErrorPrefix := '  3:';
    LOG_WARNING  : begin ErrorPrefix := 'W  :'; m_WarningError := TRUE; end;
    LOG_CRITICAL : begin ErrorPrefix := 'C  :'; m_CriticalError := TRUE; end;
    LOG_FORCE    : ErrorPrefix := 'F  :';
  end;

  Text := '['+NowDateTime+'] '+Text;

  if (LOG_BUFFER in m_LogLevel)and(ErrorState <> LOG_FORCE) then
  begin
    m_Buffer.Add(ErrorPrefix + Text);
    m_BufferModified := TRUE;
  end
  else
  begin
    m_Messages.Add(ErrorPrefix + Text);
    m_LogModified := TRUE;
  end;

  if (LOG_DUMPNOW in m_LogLevel) then
    saveLog();

end;
procedure TDebugConsole.addStrings(nStrings:TStringList);
var I : integer;
begin
  for I := 0 to nStrings.Count-1 do
  begin
    Print(LOG_DEBUG1, nStrings[I]);
  end;
end;
procedure TDebugConsole.setLogFile(const Path,FileName:string);
begin
  m_Path    := Path;
  m_LogFile := FileName;
end;
procedure TDebugConsole.saveLog();
begin
  if (not(m_LogModified) and not(m_BufferModified)) then exit; //no need to export if its not been modified

  if (m_Buffer.Count > 0) then //Auto flush the buffer on save file, in case of failure.
    FlushBuffer();

  if (Length(m_LogFile) > 0) then
    m_Messages.SaveToFile(m_Path+m_LogFile);

  m_BufferModified := FALSE;
  m_LogModified := FALSE;
end;

procedure TDebugConsole.clearBuffer();
begin
  m_Buffer.Clear;
end;
procedure TDebugConsole.flushBuffer();
var I : integer;
begin
  if (m_Buffer.Count > 0)then
  begin
    for I := 0 to m_Buffer.Count - 1 do
      m_Messages.Add(m_Buffer.Strings[ I ] );

    ClearBuffer;
  end;
end;

function TDebugConsole.showLogLevel():string;
begin
  result := 'Modes: ';
  if ( LOG_SILENT   in m_LogLevel) then result := result + 'SILENT ';
  if ( LOG_DEBUG1   in m_LogLevel) then result := result + 'DEBUG1 ';
  if ( LOG_DEBUG2   in m_LogLevel) then result := result + 'DEBUG2 ';
  if ( LOG_DEBUG3   in m_LogLevel) then result := result + 'DEBUG3 ';
  if ( LOG_WARNING  in m_LogLevel) then result := result + 'WARNING ';
  if ( LOG_CRITICAL in m_LogLevel) then result := result + 'CRITICAL ';
  if ( LOG_FORCE    in m_LogLevel) then result := result + 'FORCE ';
  if ( LOG_DUMP     in m_LogLevel) then result := result + 'DUMP ';
  if ( LOG_DUMPNOW  in m_LogLevel) then result := result + 'DUMPNOW ';
  if ( LOG_BUFFER   in m_LogLevel) then result := result + 'BUFFER ';
end;
procedure TDebugConsole.modeBuffer(isEnabled:boolean);
begin
  if (isEnabled) then
    m_LogLevel := m_LogLevel + [LOG_BUFFER]
  else
    m_LogLevel := m_LogLevel - [LOG_BUFFER];

  Print(LOG_FORCE, '[TDebug] Debug on: '+showLogLevel() );
end;
procedure TDebugConsole.modeSaveLog(isEnabled:boolean);
begin
  if (isEnabled) then
    m_LogLevel := m_LogLevel + [LOG_DUMP]
  else
    m_LogLevel := m_LogLevel - [LOG_DUMP];

  Print(LOG_FORCE, '[TDebug] Debug on: '+showLogLevel() );
end;

procedure TDebugConsole.setLogLevel(newLevel:string);
var SplitLine:TSplitLine;
begin
  SplitLine := TSplitLine.Create();
  SplitLine.explodeString(newLevel);

  m_LogLevel := [];

  with SplitLine do
  while getNextWord() do
  begin
    case SplitLine.toInt(NextWordID) of
      -8 : m_LogLevel := m_LogLevel - [LOG_DUMPNOW];
      -7 : m_LogLevel := m_LogLevel - [LOG_BUFFER];
      -6 : m_LogLevel := m_LogLevel - [LOG_DUMP];
      -5 : m_LogLevel := m_LogLevel - [LOG_DEBUG3];
      -4 : m_LogLevel := m_LogLevel - [LOG_DEBUG2];
      -3 : m_LogLevel := m_LogLevel - [LOG_DEBUG1];
      -2 : m_LogLevel := m_LogLevel - [LOG_WARNING];
      -1 : m_LogLevel := m_LogLevel - [LOG_CRITICAL];
       0 : m_LogLevel := m_LogLevel + [LOG_SILENT];
       1 : m_LogLevel := m_LogLevel + [LOG_CRITICAL];
       2 : m_LogLevel := m_LogLevel + [LOG_WARNING];
       3 : m_LogLevel := m_LogLevel + [LOG_DEBUG1];
       4 : m_LogLevel := m_LogLevel + [LOG_DEBUG2];
       5 : m_LogLevel := m_LogLevel + [LOG_DEBUG3];
       6 : m_LogLevel := m_LogLevel + [LOG_DUMP];
       7 : m_LogLevel := m_LogLevel + [LOG_BUFFER];
       8 : m_LogLevel := m_LogLevel + [LOG_DUMPNOW];
    end;
  end;
  Print(LOG_FORCE, '[TDebug] Debug on: '+showLogLevel() );
end;
procedure TDebugConsole.setDebugLevel(newLevel:integer);
begin
  case newLevel of
    0 : m_LogLevel := m_LogLevel - [LOG_DEBUG1] - [LOG_DEBUG2] - [LOG_DEBUG3];
    1 : m_LogLevel := m_LogLevel + [LOG_DEBUG1] - [LOG_DEBUG2] - [LOG_DEBUG3];
    2 : m_LogLevel := m_LogLevel + [LOG_DEBUG1] + [LOG_DEBUG2] - [LOG_DEBUG3];
    3 : m_LogLevel := m_LogLevel + [LOG_DEBUG1] + [LOG_DEBUG2] + [LOG_DEBUG3];
  end;

  Print(LOG_FORCE, '[TDebug] Debug on: '+showLogLevel() );
end;
procedure TDebugConsole.setDumpLevel(newLevel:integer);
begin
  case newLevel of
    0 : m_LogLevel := m_LogLevel - [LOG_DUMP] - [LOG_DUMPNOW];
    1 : m_LogLevel := m_LogLevel + [LOG_DUMP] - [LOG_DUMPNOW];
    2 : m_LogLevel := m_LogLevel + [LOG_DUMP] + [LOG_DUMPNOW];
  end;

  Print(LOG_FORCE, '[TDebug] Debug on: '+showLogLevel() );
end;
procedure TDebugConsole.exportMessages(var nRichEdit:TRichEdit);
var L :integer;
begin
  if not(m_LogModified) then exit; //no need to export if its not been modified

  m_LogModified := FALSE;

  with nRichEdit do
  begin
    Clear;
    for L := 0 to m_messages.Count-1 do
    begin
      if (m_Messages.Strings[L][1] = 'C') then
      begin
        SelAttributes.Color := clRed;
        SelAttributes.Style := [fsBold];
      end
      else
      if (m_Messages.Strings[L][1] = 'W') then
      begin
        SelAttributes.Color := clWebGold;
        SelAttributes.Style := [fsBold];
      end
      else
      begin
        SelAttributes.Color := DebugColor;
        SelAttributes.Style := [];
      end;

//      SelStart := GetTextLen;
//      SelText := m_Messages.Strings[L]+#13+#10;
      Lines.Add( m_Messages.Strings[L] )
    end;
  end;
end;
procedure TDebugConsole.setColor(const nColor:TColor);
begin
  DebugColor := nColor;
end;

end.
